perm filename RHYTH.F4[NEW,LCS]27 blob sn#496799 filedate 1980-02-09 generic text, type T, neo UTF8
00100	C***** SUBRS RHYTH, NOTNUM, DOTS  ********  
00200	
00300		SUBROUTINE RHYTH
00400		COMMON/RINP/R(10,85),POSNT(0/99)
00500		1 /RMOD/RMODE2,SET4,IBEAM,NOSET,STEM,STUP,NTC,PS2,
00600		1 RA,RDD,ITB,POSB /PTR/KWDS(1) /FRMT/FQZ(3)
00700		1 /XRN/RN(1) /IDEV/IDEV
00800		1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00900		1 /SCX/JALPHA(30),JX,JXX,JZ,IRHY,JD,KA,KB,IZ
01000		1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,
01100		1 NFLG,KXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
01200		1 /ALF/INP(59),NX,NOTE,JSET,KZ,KX,AVGPOS,RLPOS,RLP2,
01300		1 AVP2,ZX,RE,ZZ,RD,RSTX
01400	C   SEE ALSO FILLMS, SETLET AND SETUP  RE. /FLM/
01500		DIMENSION RPOS(2,100)
01600		COMMON R2,JH,CENTR,J2,R3,R4,R5,RJQ(17),J3,JQ(19)
01700		1 /DPY/ST(4000),MEDIT,GO /LIMIT/LIMIT,ITEM,NL,NO,NONO
01800		1 /POS/POS1,POS2 /STF/RSTFAC(0/7),RSTJ2
01900		EQUIVALENCE (VX(1),X),(VX(2),Y),(VX(7),Z),(RPOS,ST(3400))
02000		1,(VX(3),AB),(VX(4),T),(VX(5),RB),(VX(6),X2)
02100		1,(VX(8),C),(VX(9),S),(VX(10),X3)
02200	
02300	CCC	DATA FIB/.75/
02400	C  FIB IS FOR PSUEDO-FIBONACCI SPACING
02500		RSTJ3=RSTFAC(IFIX(STAFF))
02600		POSNT(0)=-1
02700		POSNT(1)=-1
02800	C IN CASE 1ST NOTE IS AT POS. ZERO
02900		NX=-1
03000		JX=0
03100		T=0
03200		Y=0
03300		NOTE=0
03400		ICNTPT=-1
03500		NOSET=0
03600		JSET=0
03700	C  STUP IS NEG. IF SETUP IS NOT READY
03800		IF(STUP)GO TO 341
03900		IF(SET4.NE.STAFF)GO TO 70
04000		NOSET=-1
04100	C  TO ADD MORE NOTES ON SETUP LINE. WIPES OUT P9 AT END OF SCMSS.
04200		GO TO 270
04300	70	DO 370 K=1,ITEM-1
04400	CXX******** 1/80  70	DO 370 K=1,ITEM-IZ-1
04500	C LOOKS ONLY AT THINGS BEFORE CURRENT INPUT.
04600		J=KWDS(K)
04700		IF(RN(J+1).GT.2)GO TO 370
04800		IF(RN(J+2).EQ.STAFF)GO TO 270
04900	370	CONTINUE
05000		GO TO 170
05100	270	ICNTPT=0
05200	C THIS WILL CAUSE NOTES ADDED TO LINE TO HAVE NO RHYTH VAL IN P9
05300	170	KZ=1
05400		POS2=PS2
05500	C  GETS LAST ↑↑ POS. FROM SETUP
05600		JSET=-1
05700	C  NEXT NUM.(100) IS LIMIT FOR STF.4 (CAN BE UP TO 300-SEE /FLM/)
05800		DO 9 KX=1,100
05900	9	IF(RPOS(2,KX).GE.0)GO TO 10
06000	10	AVGPOS=RPOS(1,KX)
06100		RLPOS=AVGPOS
06200	344	KX=KX+1
06300		IF(RPOS(2,KX).EQ.-3)GO TO 344
06400	C**** IGNORES CLEFS (BUT NOT BARS) IN AUTOMATIC SPACING ***** 10/76
06500		RLP2=RPOS(1,KX)
06600	343	AVP2=RPOS(2,KX)-.001
06700		IF(AVP2.GT.0)GO TO 341
06800		KX=KX+1
06900		GO TO 343
07000	C  AVERAGED AND REAL POSITIONS FROM 'SETUP'
07100	
07200	C  NEXT FOR NON-SETUP
07300	341	DO 34 K=1,IRHY
07400		CALL DOTS(VAL,RH,K,DOT)
07500	C VAL=RHYTH. VALUE (QTR=1), RH=DENOMINATOR (QTR=4), DOT=NUM OF DOTS
07600	C  88TH NOTES ARE TAKEN AS GRACE NOTES. THEN BECOME 32NDS.
07700		IF(RH.NE.88)GO TO 345
07800		IF(JSET)GO TO 34
07900	C  GRACE NOTES SKIPPED IN AUTOMATIC SETUP
08000		VAL=.1    
08100	CFIB345	IF(STUP.LT.-1)VAL=PFIBX(VAL)
08200	345	IF(STUP.LT.-1)VAL=14.0*EXP(ALOG(VAL)*0.5849624)
08300	C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5))  NOT FIBBONACI (1.618)
08400	CCC345	IF(STUP.LT.-1)Z=Z+(.125-Z)*FIB
08500	C  STUP CAN BE SET TO .LT.-1 IN NOTBMS FOR PSUEDO-FIBONACCI SPACE
08600		Y=Y+VAL
08700	34	CONTINUE
08800	C  Y=TOTAL TIME
08900	C A SAFEGUARD
09000	C  SAVES POS1 FOR POSITIONING MF, CRESC. ETC.
09100		NTC=0
09200	C  THE WORD COUNT FOR REAL NOTES.
09300		IF(JSET)GO TO 3421
09400	
09500		IF(POS1.LT.POS2)POSX=POS1
09600	C  SAVES IT FOR BACKUP
09700		IF(POS1.GE.POS2)POS1=POSX
09800	
09900		Z=POS2-POS1
10000		ZX=Z
10100	342	DO 1 K=1,IZ
10200		X=R(1,K)
10300		IF(X.LT.3.)GO TO 1
10400	C  JUMP IF NOTE OR REST
10500		IF(X.NE.17.)GO TO 8
10600	C   JUMP IF NOT A KEY SIG.
10700		RA=AMOD(R(5,K),100.0)
10800	C  100+KEY SIG NUM  =  SIG MADE UP OF NATURALS.
10900		RA=2.+ABS(RA)*2.0
11000		IF(K.GT.1)R(8,K-1)=R(8,K-1)+RSTJ3
11100	C PUSH KSIG 1*SIZE TO RIGHT OF PREVIOUS ITEM.
11200		GO TO 6
11300	8	IF(X.NE.4.)GO TO 81
11400	C   NEXT IS FOR BAR LINES
11500		RA=3
11600		J=K+1
11700		RE=R(1,J)
11800		IF(RE.EQ.3.)RA=1.5
11900	C  A CLEF
12000		IF(RE.EQ.18)RA=2.5
12100	C  A METER
12200		IF(RE.NE.1)GO TO 83
12300		IF(AMOD(R(5,J),10.).NE.0)RA=4.5
12400	C  FINDS ACCI ON NEXT NOTE.
12500	83	IF(K.EQ.IZ)RA=0
12600	C  END OF STAFF
12700		GO TO 6
12800	82	RA=5
12900	CGHB82	RA=6
13000		GO TO 83
13100	81	IF(X.EQ.18)GO TO 82
13200		RA=6.
13300		IF(K.LT.3)RA=8.
13400	CGHB	RA=7.
13500	C   FOR CLEFS
13600	CGHB	IF(K.LT.3)RA=9.
13700	C   THE FIRST CLEF IS NOT MINI
13800	6	RA=RA*RSTJ3
13900	C  SO SPACE WILL DEPEND ON SIZE OF STAFF
14000		Z=Z-RA
14100		R(8,K)=RA
14200	C   STORES SPACE NUM THAT MUST BE GIVEN BACK
14300	1	CONTINUE
14400	C   SUBTRACTS SPACE FOR CLEF OR BAR.  WILL ADD BOTH LATER.
14500	C  POS1 AND Z ARE FOR RHYTHMIC SPACING
14600	C  SPACE FOR NON-NOTES
14700	3421	K=0
14800		IF(ABS(Y-RA).LE..001)GO TO 3
14900		IF(JSET)CALL MISMCH(RA,Y)
15000	C TYPES MISMATCH MESSAGE
15100	
15200	C   LOOP TO END
15300	3	K=K+1
15400	C   K IS COUNTER
15500		T=0
15600	CXX	R(7,K)=0
15700		RE=R(1,K)
15800		IF(RE.LE.2.)GO TO 2
15900		RD=R(8,K)
16000		R(8,K)=0
16100		IF(JSET)GO TO 71
16200	
16300	7	IF(K.EQ.IZ)POS1=POS2
16400		IF(R(1,K-1).GT.2.)GO TO 73
16500		IF(K.EQ.1)GO TO 73
16600		IF(RE.EQ.4.)GO TO 73
16700		Z=Z+RD/3.
16800	C   RETURNS 1/3 OF THE SPACE IF PREV. ITEM IS NOTE OR REST
16900		POS1=POS1-RD/3
17000	C  THIS CAN RESULT IN OVERLAP WHICH MUST BE EDITED OUT.!!
17100	73	R(3,K)=POS1
17200	72	POS1=POS1+RD
17300	C   ABOVE SECTION LEAVES ROOM FOR CLEF OR BAR
17400		GO TO 337
17500	
17600	C  40???   50????  WHY NOT 100?
17700	71	DO 74 J=KZ,80
17800	74	IF(RE.EQ.-RPOS(2,J))GO TO 75
17900		POS=R(3,K-1)+4
17920	C DON'T BACK OUT OF ARRAY
17950		IF(K.EQ.1)POS=POS1
18000		GO TO 76
18100	75	POS=RPOS(1,J)
18200		KZ=J+1
18300	C  FOUND SAME TYPE OF ITEM.
18310		IF(K.EQ.1)GO TO 76
18320		RA=R(3,K-1)
18330	C GET POSITION OF PREVIOUS ITEM
18340		IF(POS.LT.RA)POS=RA+3
18350	C ARBITRARY POSITION FOR CLEF IF IT TRIES TO MATCH ONE SOMEWHERE ELSE.
18400	76	R(3,K)=POS
18500		GO TO 337
18600	
18700	2	JX=JX+1
18800	21	CALL DOTS(VAL,RH,JX,DOT)
18900		V(JX)=VAL
19000		IF(RE.NE.2)GO TO 121
19100		V(JX)=-VAL
19200	C  SHOWS RESTS IN AUTO. BEAM SECTION.(ASSUMES REST WAS A + NUMB.)
19300		R(7,K)=VAL
19400		GO TO 210
19500	121	IF(R(8,K).GE.-1.)R(9,K)=VAL
19600	C  STORES RHYTH VALUE FOR LATER USE IN PART EXTRACTOR IF NOT CHORD NOTE.
19700	CCC	IF(AB.GT..05)GO TO 210
19800		IF(RH.NE.88.)GO TO 210
19900		R(3,K)=-1.
20000		R(4,K)=R(4,K)+100.
20100	C  WILL THIS BE OK WITH NOTES BELOW B3 (I.E. NEG POSITIONS.
20200		R(7,K)=1
20300	C  FOUND A GRACE NOTE  (88TH NOTE)   
20400		RB=4./88.
20500		R(9,K)=RB    
20600		JZ=1
20700		IF(STEM.GE.0)GO TO 1211
20800		IF(R(9,K-1).EQ.RB)GO TO 1211
20900	4211	IF(V(JX+1).EQ.88..AND.R(1,K+1).EQ.1)GO TO 1211
21000	C  STEM WILL BE UP UNLESS PRESET OR TWO OR MORE IN A ROW.
21100		IF(R(5,K).GE.20.)R(5,K)=R(5,K)-10.
21200	C NOW STEM IS UP
21300	
21400	1211	IF(R(8,K+JZ).GE.0)GO TO 211
21500		J=K+JZ
21600	C GRACE NOTE CHORDS
21700		R(3,J)=-1
21800	C  FOR AUTO-SPACING AT 337
21900		R(4,J)=R(4,J)+100.
22000	C MAKE IT A MINI-NOTE
22100		R(8,K)=1000.+ABS(R(4,K)-R(4,J))
22200	C  EXTEND THE STEM
22300		JZ=JZ+1
22400	C  FOR MORE CHORD NOTES.  SHOULD I CHECK FOR END (IZ)?
22500		GO TO 1211
22600	C  ** NOT NOW ***TURNS STEM OVER. UNLESS STEM DIRECTIONS WERE FIXED.(SU/SD/)
22700	211	IF(JZ.LE.1)R(8,K)=1000
22800	2211	IF(JSET.GE.0)GO TO 3211
22900		K=K+JZ-1
23000	C  POS WILL BE SET AT 336
23100		NTC=NTC+1
23200	C  UPDATE THE COUNTER FOR IMPORTANT POSITIONS. POSNT SET AT 336
23300		POSNT(NTC)=-1
23400		GO TO 337
23500	3211	VAL=.1    
23600	C IT USED TO JUMP.  NOW MAKES SPACE FOR GRACE NOTES AS 32NDS.
23700	210	RB=0
23800	C  FOR AUTOMATIC SETUP
23900		JZ=K
24000	C  JZ WILL BE USED NEAR END
24100	CC3634	IF(AMOD(AB,.1875).EQ.0)GO TO 122
24200	CC	T=IDOT*10
24300	C IDOT IS NUM OF DOTS
24400		IF(RE.EQ.2.)GO TO 35
24500		IF(RH.EQ.88)GO TO 22
24600	CXX	T=0
24700		IF(RH.LT.8)GO TO 522
24800	CC	IF(R(5,K).LT.10)GO TO 422
24900	C DON'T ADD TAILS TO STEMLESS NOTE. (IT CONFUSES 'BEAMS')
25000		T=IFIX(ALOG(RH)/0.6931472+.001)-2.0
25100	C RH=8=1 TAIL,  16=2TAILS, ETC. THE NUM. (8,16) IS RESULT OF 2 TO THE NTH.
25200	522	RB=0
25300		IF(DOT.EQ.0)GO TO 422
25400		IF(R(6,K).GE.20)RB=100 
25500	C  TO SHIFT DOT DOWN 2 STEPS
25600	422	R(7,K)=T+RB+DOT
25700		T=0
25800	cc422	R(7,K)=T+IDOT
25900	C  PUTS ONE OR MORE DOTS
26000	CC	GO TO 36
26100		GO TO 22
26200	
26300	35	IF(R(6,K).GE.0)GO TO 135
26400		R(6,K)=-1
26500		GO TO 22
26600	C  ADDS DOT TO REST. (IF R6 IS -2. = INVIS. REST. CHANGE IT TO -1)
26700	135	IF(R(8,K).EQ.0)R(6,K)=DOT/10.
26800	C  NO DOTS ON 'WHOLE MEASURE' RESTS
26900	CC35	R(6,K)=T/10.
27000	CC36	RB=VAL/3.
27100	CC	IF(T.NE.1)RB=(4*VAL)/7
27200	C  TO KEEP TAIL ON DOTTED NOTE
27300	
27400	22	POS=POS1
27500		IF(R(6,K).GE.30)R(6,K)=R(6,K)-30
27600	C  30 NEEDED FOR SOME CASES WITH DOTS ON CHORDS.
27700		IF(JSET.EQ.0)GO TO 220
27800	
27900	C  NEXT IS FOR SETUP
28000	222	IF(NOTE)GO TO 223
28100	C  FIRST TIME A NOTE IS FOUND.
28200		NOTE=-1
28300		POS1=RLPOS
28400		Z=POS2-POS1
28500	C  RESETS SPACE AVAILABLE, ZZ IS SPACE FOR NON-NOTES
28600	223	IF(POS1.LT.AVP2)GO TO 221
28700	224	KX=KX+1
28800	C???? OCT, 73	 	IF(NX.EQ.0)GO TO 225
28900		L=KX
29000	1228	IF(RPOS(2,L).NE.-3)GO TO 228
29100		L=L+1
29200	C  IGNORE CLEFS (BUT NOT BARS) ********* 10/76
29300		GO TO 1228
29400	228	IF(NX)RLP2=RPOS(1,L)
29500		NX=-1
29600	225	IF(RPOS(2,KX-1))GO TO 227
29700		RLPOS=RPOS(1,KX-1)
29800		AVGPOS=AVP2
29900	227	AVP2=RPOS(2,KX)-.001
30000		IF(AVP2.GT.0)GO TO 223
30100	C  0 IN RPOS=POS. OF NON-NOTE
30200	CC****** WHY NEEDED?? 6/74 ***	IF(RLP2.GE.POS1)NX=0
30300		NX=0
30400	CC*****↑↑↑↑ CHANGED FROM ABOVE ***  6/74
30500		GO TO 224
30600	221	POS=(POS1-AVGPOS)*(RLP2-RLPOS)/(AVP2-AVGPOS)+RLPOS
30700	220	R(3,K)=POS
30800	4634	IF(RE.NE.1)GO TO 44
30900		IF(POS.EQ.POSNT(NTC))GO TO 2634
31000	C  SKIPS OTHER CHORD NOTES.
31100		NTC=NTC+1
31200		POSNT(NTC)=POS
31300	C  SAVES IT FOR NUMBS ABOVE NOTES, ETC.
31400	2634	IF(RH.LT.4)GO TO 4
31500	C JUMP IF DENOM. IS LESS THAN 4.  I.E. 1/2 NOTE ETC.
31600	44	L=K+1
31700		IF(R(8,L).GE.0)GO TO 1634
31800		IF(R(1,L).NE.1.)GO TO 1634
31900	C   JUMP IF NOT DOUBLE STOP
32000	C  DELETES STEM FROM WHOLE NOTE CHORD (NOW DONE IN NOTWRT IF P7=1)
32100		R(3,L)=R(3,K)
32200		K=L
32300	CC	R(8,K)=0
32400		GO TO 522 
32500	C  LOOPS BACK TO PICK UP MORE CHORD NOTES
32600	
32700	C 'WHITENS' HALF, WHOLE AND TRIPLET HALF NOTES.
32800	4	RA=-R(6,K)
32900		IF(RA.EQ.0)RA=-1
33000		IF(RH.GE.2.)GO TO 144
33100		R(5,K)=AMOD(R(5,K),10.0)
33200	C  TAKES STEM INFO OFF ANYTHING LONGER THAN 1/2 NOTES -- FOR SLUR ROUTINE.
33300		RP=1
33400		IF(RH.LE..5)RP=2
33500		R(7,K)=R(7,K)+RP
33600	C  +1=WHOLE NOTE WILL PRINT  +2=DBL WHL NT.
33700	CC NOT NEEDED BECAUSE OF ABOVE. 	RA=-2.
33800	144	R(6,K)=RA
33900		GO TO 44
34000	
34100	1634	T=POS1
34200		RP=VAL
34300	CFIB	IF(STUP.LT.-1)RP=PFIBX(VAL)
34400		IF(STUP.LT.-1)RP=14.0*EXP(ALOG(RP)*0.5849624)
34500	C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5))  NOT FIBBONACI (1.618)
34600	CCC	IF(STUP.LT.-1)RP=AB+(.125-AB)*FIB
34700	C  FOR PSUEDO-FIB. SPACING
34800		POS1=RP/Y*Z+POS1
34900	535	IF(R(1,JZ).EQ.1.)GO TO 337
35000		RA=R(4,JZ)
35100	C  SETS REST
35200		IF(R(8,JZ).NE.0.1)GO TO 537
35300		T=-4
35400	C*****	R(8,JZ)=-2
35500	C  -2 CENTERS THE SIGN UNDER THE RIGHT CONDITIONS
35600		GO TO 536
35700	CC537	IF(VAL.LT.2)GO TO 538
35800	CC	T=-1
35900	CC	IF(RH.LT.2)T=-2
36000	CC	IF(RH.LT.1)T=-3
36100	C  -1=HLF RST, -2=WHOLE, -3=DBL WHL RST, -4=REPEAT BAR SIGN(./.)
36200	CC	GO TO 536
36300	537	T=IFIX(ALOG(RH)/0.6931472+.001)-2.
36400	536	R(5,JZ)=T
36500	CCC	GO TO 337
36600	C*******  4/74  NEW WAY TO FIND TAILS
36700	C  OMITS RESTS  (REALLY???)
36800	CCC334	R(7,JZ)=T+R(7,JZ)
36900	337	IF(K.LT.IZ)GO TO 3
37000	CXXXXXXXX	M=NTC+1		XXXXXXXXX 9/28/78
37100	C********* WAS M=NTC ******* 4/14/78
37200		M=NTC
37300		DO 335 K=IZ,1,-1
37400		IF(R(3,K).GE.0)GO TO 335
37500		IF(K.NE.IZ)GO TO 336
37600		R(3,K)=POS2-4.
37700		GO TO 335
37800	336	N=K-1
37900	1336	RA=R(3,N)
38000		IF(RA.GT.0)GO TO 2336
38100		N=N-1
38200		IF(N.GT.0)GO TO 1336
38300	C GO BACK (IF MORE GRACE NOTES.) TO FIND PREVIOUS BIG NOTE.
38400	2336	T=R(3,K+1)
38500		RB=T-RA
38600		RA=3
38700		IF(RB.LE.4)RA=RB/2.
38800	C IF SPACE IS SMALL USE 1/3 OF IT.
38900		RB=T-RA
39000	C NEXT FOR GRACE NOTE CHORDS
39100		IF(R(8,K+1).GE.0)GO TO 1335
39200		RB=T
39300	CC	RB=R(3,K+1)
39400	CXXXX	M=M+1
39500	1335	R(3,K)=RB
39600		POSNT(M)=RB
39700	335	IF(R(8,K).GE.0.AND.R(1,K).EQ.1)M=M-1
39800	C COUNT ONLY NOTES - BUT NOT NON-RHYTH CHORD NOTES.
39900		K=0
40000	45	K=K+1
40100	C  NEXT IS TO ARRANGE DOTS.
40200		IF(R(7,K).LT.10)GO TO 451
40300		RA=R(3,K)
40400		DO 452 M=K+1,IZ
40500		IF(R(3,M).NE.RA)GO TO 453
40600	C  JUMP IF NOT CHORD NOTE.
40700		T=R(7,M)
40800		RB=R(4,M)
40900		IF(T.LT.100.)GO TO 452
41000	C  JUMP IF NOTE IS NOT ON LEFT SIDE OF UPWARD STEM
41100		IF(RB-R(4,M-1).NE.2)GO TO 452
41200		IF(AMOD(RB,2.).NE.0)R(7,M)=AMOD(T,10.)
41300	C  TAKES AWAY DOT IN CERTAIN CASES TO AVOID CONFUSION.
41400	452	CONTINUE
41500	453	K=M-1
41600	451	IF(K.LT.IZ)GO TO 45
41700	
41800		IF(ICNTPT)GO TO 13
41900		DO 113 K=1,IZ 
42000		RA=R(1,K)
42100		IF(RA.GT.2)GO TO 113
42200	C THIS ZEROS RHYTH PARAM IF NOTES WERE ALREADY ON THIS LINE.
42300		J=9
42400		IF(RA.EQ.2)J=7
42500		R(J,K)=0
42600	113	CONTINUE
42700	13	N=IZ
42800		NTC=NTC+1
42900		POSNT(NTC)=200
43000		POSNT(0)=0
43100		IF(IDEV.EQ.5)CALL NOTNUM
43200		END
43300	
43400		SUBROUTINE NOTNUM
43500	CC	DIMENSION ISU(390)
43600		COMMON R2,JH,CENTR,J2,R3,R4,R5,RJQ(17),J3,J4,J5,JQ(17)
43700		1 /RINP/R(10,85),POSNT(0/99)
43800		1 /RMOD/RMODE2,SET4,IBEAM,NOSET,STEM,STUP,NTC,PS2
43900		1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
44000		1 /POSI/STFF(0/7),JJ2,POSQ /DPY/ST(4000),MEDIT,GO
44100		CALL DPYSET(3,ST(3600),390)
44200		CALL DPYBRT(6)
44300		J2=STAFF
44400		POSQ=STFF(J2)
44500		J5=1
44600		R4=20
44700	C  R5=0=1  STANDARD SIZE IS USED.
44800		R6=0
44900	C NUMBERS ALWAYS DEFAULT SIZE(0=1)
45000		DO 131 K=1,NTC-1
45100		R3=RHORZ(POSNT(K))
45200		CALL PNUM
45300	C  GOES TO DRAW A NUMBER OVER A NOTE
45400		J5=J5+1
45500		IF(J5.EQ.10)J5=0
45600	131	CONTINUE
45700	132	CALL DPYOUT(3)
45800		CALL SETPOG(1)
45900		END
46000	
46100		SUBROUTINE DOTS(VAL,RH,K,DOT)
46200		COMMON/SCM/V(1)
46300	C FINDS DOTS (1000S), GET RHYTH. AND RHYTHMIC VALUE (QTR=1)
46400		RH=V(K)
46500		IF(RH.EQ.0)RH=88.
46600		VAL=4/RH
46700		J=RH/1000.
46800		DOT=J*10
46900		IF(J.EQ.0)RETURN 
47000		RH=RH-J*1000
47100		VAL=4./RH
47200		Z=VAL
47300	1	Z=Z/2
47400		VAL=VAL+Z
47500		J=J-1
47600		IF(J.GT.0)GO TO 1
47700		END